open Ast

let qt str = "\"" ^ str ^ "\""

let rec range n = 
	if n = 0 then [] else
	n::(range (n-1))
  
let name_list l = List.map (fun i -> "obj"^string_of_int i) ((List.rev (range  (List.length l))))

let rec ppcode_of_types types =

	let rec ppcode_of_structure s =
		"(fun s -> \"{\" ^
		inner_indent (fun u -> newline() ^ " ^
		
		(String.concat 
			("\n ^ newline() ^ ") 
			(List.map 
				(fun (member, mtype) -> 
					"(\"" ^ member ^ " = \" ^ " ^ ppcode_of_t mtype ^ " s." ^ member ^ ")"
				)
				s))
		
		^ ") ^ newline() ^ \"}\")"
		
	and ppcode_of_enum e =
		"(function " ^
		(String.concat 
			"\n| "
			(List.map
				(fun (name, t) -> match t with
					  None -> name ^ " -> " ^ qt name
					| Some(Tuple(tuple_components)) -> let tc_names = name_list tuple_components in
						name ^ "(" ^ (String.concat ", " tc_names) ^ ") -> \""^name^"(\" ^ "
						^ (String.concat (" ^ " ^ qt ", " ^ " ^ ") (List.map
						(fun (cname, ctype) -> "(" ^ (ppcode_of_t ctype) ^ " " ^ cname ^ ")")
						(List.combine tc_names tuple_components)))
						^ " ^ \")\"" 
					| Some(x) -> name ^ "(x) -> \"" ^ name ^ "(\" ^ " ^ ppcode_of_t x ^ " x" ^ "^\")\"" 
				)
				e
			)
		)
		^ ")"
		
	and ppcode_of_t = function
		  Type_id(t_id) -> "string_of_" ^ t_id
		| Tuple(t_list) -> let tc_names = name_list t_list in
			  "(fun (" ^ (String.concat ", " tc_names) ^ ") -> \"(\" ^ "
			^ (String.concat (" ^ " ^ qt ", " ^ " ^ ") (List.map
				(fun (cname, ctype) -> "(" ^ (ppcode_of_t ctype) ^ " " ^ cname ^ ")")
			   (List.combine tc_names t_list)))
			^ " ^ \")\")" 
		| List(t) -> "(string_of_list (" ^ ppcode_of_t t ^ "))"
		| Option(t)	->  "(string_of_option (" ^ ppcode_of_t t ^ "))"
		| Ref(t)	->  "(string_of_ref (" ^ ppcode_of_t t ^ "))"
		
	and ppcode_of_type t =
		(* let rec, or and preappended *)
		" string_of_" ^ t.t_name ^ " obj = ((" ^
		(match t.body with
			Structure(s) -> ppcode_of_structure s
		  | Enum(e) -> ppcode_of_enum e
		  | T_inline(t) -> ppcode_of_t t)
		^ ") obj)"
	in

(* copied to start of generated code *)		
"
	open "^Sys.argv.(1)^"						(* this should probably be specified @ command line *)
	(* Generated by ast-pp *)
	
	(* indentation utilities *)

	type pp_indentation = {
		pp_indentation_curr : string;
		pp_indentation_prev : pp_indentation option
	}
  
	let pp_indentation_level = ref {
		pp_indentation_curr = \"\\n\"; 
		pp_indentation_prev = None
	}
	
	(* balence push_indent with pop_indent *)
	
	let push_indent u = 
		pp_indentation_level := {
			pp_indentation_curr = !pp_indentation_level.pp_indentation_curr  ^ \"    \";
			pp_indentation_prev = Some(!pp_indentation_level)
		}
	
	let pop_indent u =
		match !pp_indentation_level.pp_indentation_prev with
			  None -> ()	(* this is actually an error, but we just leave newline *)
			| Some(prev) -> pp_indentation_level := prev
			
	let inner_indent f =
		let str = (push_indent(); f()) in (pop_indent(); str)
	
	(* get the indentation with newline().
	   The default is just a newline, additional pushes are tabs.
	   This way, anytime you want a new line, it will be properly indented *)
	
	let newline u = !pp_indentation_level.pp_indentation_curr
	
	(* builtin functions *)
	
	let enum x = \"enum\"
	let tuple x = \"tuple\"
	let string_of_string str = \"\\\"\" ^ str ^ \"\\\"\"
	let string_of_list f l = 
		\"[\"
		^ (inner_indent (fun u -> newline() ^
			String.concat (\";\"^newline()) (List.map f l)))
		^ newline() ^ \"]\"

	let string_of_option f = function
		  None -> \"None\"
		| Some(x) -> f(x)	

    let string_of_ref f r = f (!r)

	let rec "
	^ String.concat "\n\n and " (List.map ppcode_of_type types)
	^ "\n\n"

let _ =
  let lexbuf = Lexing.from_channel stdin in
  let program = Parser.types Scanner.token lexbuf in
  print_string (ppcode_of_types program)
